home *** CD-ROM | disk | FTP | other *** search
/ The World's Largest Collection of Windows Software / The World's Largest Collection of Windows Software - Disc 2.iso / textproc / tlcspell / spellm1.ba_ / spellm1.ba
Text File  |  1993-12-02  |  7KB  |  201 lines
  1. Option Explicit
  2.  
  3. DefInt A-Z
  4.  
  5. Global Const HELP_CONTEXT = &H1           'Display topic in ulTopic
  6. Global Const HELP_QUIT = &H2              'Terminate help
  7. Global Const HELP_INDEX = &H3             'Display index
  8. Global Const HELP_CONTENTS = &H3
  9. Global Const HELP_HELPONHELP = &H4        'Display help on using help
  10. Global Const HELP_SETINDEX = &H5          'Set the current Index for multi index help
  11. Global Const HELP_SETCONTENTS = &H5
  12. Global Const HELP_CONTEXTPOPUP = &H8
  13. Global Const HELP_FORCEFILE = &H9
  14. Global Const HELP_KEY = &H101             'Display topic for keyword in offabData
  15. Global Const HELP_COMMAND = &H102
  16. Global Const HELP_PARTIALKEY = &H105      'call the search engine in winhelp
  17.  
  18.  
  19.  
  20. ' MsgBox parameters
  21. Global Const MB_OK = 0                 ' OK button only
  22. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  23. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  24. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  25. Global Const MB_YESNO = 4              ' Yes and No buttons
  26. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  27.  
  28. Global Const MB_ICONSTOP = 16          ' Critical message
  29. Global Const MB_ICONQUESTION = 32      ' Warning query
  30. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  31. Global Const MB_ICONINFORMATION = 64   ' Information message
  32.  
  33. ' MsgBox return values
  34. Global Const IDOK = 1                  ' OK button pressed
  35. Global Const IDCANCEL = 2              ' Cancel button pressed
  36. Global Const IDYES = 6                 ' Yes button pressed
  37. Global Const IDNO = 7                  ' No button pressed
  38.  
  39. Global Const OFN_OVERWRITEPROMPT = &H2&
  40. Global Const OFN_PATHMUSTEXIST = &H800&
  41. Global Const OFN_FileMustExist = &H1000&
  42. '
  43. 'Declare Function SetPPStr Lib "kernel" Alias "WritePrivateProfileString" (ByVal s$, ByVal i$, ByVal V$, ByVal P$)
  44. 'Declare Function GetPPInt Lib "Kernel" Alias "GetPrivateProfileInt" (ByVal s$, ByVal E$, ByVal i, ByVal F$)
  45. 'Declare Function GetPPStr Lib "Kernel" Alias "GetPrivateProfileString" (ByVal Sect$, ByVal Ent$, ByVal Def$, ByVal Ret$, ByVal Lenth, ByVal File$)
  46. 'Declare Function WinDir Lib "Kernel" Alias "GetWindowsDirectory" (ByVal B$, ByVal nSize)
  47. 'Declare Function GetPStr Lib "Kernel" Alias "GetProfileString" (ByVal Sect$, ByVal Ent$, ByVal Def$, ByVal Ret$, ByVal Lenth)
  48.  
  49. 'Declare Function GetFocus Lib "User" ()
  50. 'Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
  51. 'Declare Function GetTickCount Lib "User" () As Long
  52.  
  53.  
  54. Declare Function WFind Lib "TlcDic.dll" (ByVal AWord$, ByVal Add, ByVal Filename$)
  55. Declare Function DelWord Lib "TlcDic.dll" (ByVal AWord$, ByVal Filename$)
  56. Declare Function ReadDic Lib "TLCDic.DLL" (ByVal fn$, ByVal stem$, ByVal hListBox)
  57.  
  58. Global LexPath As String
  59. Global spage As Long
  60. Global LastCk As Integer
  61. Global part As String
  62. Global WordStart As Integer
  63. Global WordEnd As Integer
  64. Global DataFile As String
  65.  
  66. Function ChkWord ()
  67.     Dim i As Integer, k As Integer
  68.     Dim Done As Integer
  69.     i = LastCk + 1
  70.     ChkWord = 0
  71.     ' Find first alpha character
  72.     While i < spage And Not Done
  73.         If UCase(Mid(FrmDoc!Text1, i, 1)) < "A" Or UCase(Mid(FrmDoc!Text1, i, 1)) > "Z" Then
  74.            i = i + 1
  75.         Else
  76.            Done = True
  77.         End If
  78.     Wend
  79.     If i = spage Then
  80.        MsgBox "Speller has reach the end of this page."
  81.        Unload FrmChk
  82.        Exit Function
  83.     End If
  84.     
  85.     Done = False
  86.     WordStart = i
  87.     ' Find first non alpha character
  88.     While i < spage And Not Done
  89.         If UCase(Mid(FrmDoc!Text1, i, 1)) < "A" Or UCase(Mid(FrmDoc!Text1, i, 1)) > "Z" Then
  90.            Done = True
  91.         Else
  92.            i = i + 1
  93.         End If
  94.     Wend
  95.     If i = spage Then
  96.        MsgBox "Speller has reach the end of this page."
  97.        Unload FrmChk
  98.        Exit Function
  99.     End If
  100.     Done = False
  101.     WordEnd = i
  102.     LastCk = i - 1
  103.     If FrmChk!CkHilight = 1 Then
  104.        FrmDoc!Text1.SelStart = WordStart - 1
  105.        FrmDoc!Text1.SelLength = WordEnd - WordStart + 1
  106.     End If
  107.   
  108.     ChkWord = TestWord(LCase(Mid(FrmDoc!Text1, WordStart, WordEnd - WordStart)))
  109.  
  110. End Function
  111.  
  112. Function GetFileName (Act As Integer, NewFile As String)
  113.    Dim i As Integer
  114.       GetFileName = 0
  115.       FrmAbout!CmnDialog.Flags = OFN_OVERWRITEPROMPT + OFN_PATHMUSTEXIST
  116.       FrmAbout!CmnDialog.Filename = "*.Txt"
  117.       FrmAbout!CmnDialog.Filter = "Text |*.Txt | Logs |*.Log |All |*.*"
  118.       FrmAbout!CmnDialog.FilterIndex = 0
  119.       FrmAbout!CmnDialog.CancelError = True
  120.       If Act = 1 Then
  121.          FrmAbout!CmnDialog.DialogTitle = "Read File"
  122.          FrmAbout!CmnDialog.Flags = FrmAbout!CmnDialog.Flags + OFN_FileMustExist
  123.       Else
  124.          FrmAbout!CmnDialog.DialogTitle = "Save File As"
  125.       End If
  126.       FrmAbout!CmnDialog.InitDir = Mid$(LexPath, 1, Len(LexPath) - 1)
  127.       On Error Resume Next
  128.       FrmAbout!CmnDialog.Action = Act
  129.       If Err Then
  130.          On Error GoTo 0
  131.          Exit Function
  132.       End If
  133.       NewFile = FrmAbout!CmnDialog.Filename
  134.       GetFileName = 1
  135. End Function
  136.  
  137. Sub Main ()
  138.     LexPath = App.Path + "\"
  139.     App.HelpFile = LexPath + "TLCSpell.Hlp"
  140.     FrmDoc.Show
  141. End Sub
  142.  
  143. Sub ReadFile (Filename As String)
  144.     Dim fn As Integer, fsiz As Long, rsiz As Integer
  145.     fn = FreeFile
  146.     On Error GoTo ReadFileErr1
  147.     Open Filename For Binary As #fn
  148.     fsiz = FileLen(Filename)
  149.     If fsiz - spage > 20000 Then
  150.        rsiz = 20000
  151.     Else
  152.        rsiz = fsiz
  153.     End If
  154.     part = Space(rsiz)
  155.     Get #fn, spage, part
  156.     Close
  157.     spage = spage + rsiz
  158.     FrmDoc!Text1 = Trim(part)
  159.     part = ""
  160.     Exit Sub
  161. ReadFileErr1:
  162.     MsgBox Error
  163.     Close
  164.     Resume ReadFileQuit
  165. ReadFileQuit:
  166. End Sub
  167.  
  168. Sub SetParams ()
  169.    Dim IniPath As String
  170.    Dim i As Integer
  171.     '  IniPath = "WordGame.ini"
  172.     '  Skill = GetPPInt("GameOptions", "Skill", 0, IniPath)
  173.     '  Flags = GetPPInt("GameOptions", "Rule", 6, IniPath)
  174.     '  GFontSize = GetPPInt("GameOptions", "FontSize", 12, IniPath)
  175.      ' HandSize = GetPPInt("GameOptions", "HandSize", 5, IniPath)
  176.      ' TimeLimit = GetPPInt("GameOptions", "TimeLimit", 0, IniPath)
  177.      ' BoardSize = GetPPInt("GameOptions", "BoardSize", 12, IniPath)
  178. End Sub
  179.  
  180. Function TestWord (Word As String)
  181.     Dim i As Integer, hListBox
  182.     Dim Addit As Integer
  183.     Addit = False
  184.     i = WFind(Word, Addit, LexPath + "English.Lex")
  185.     If i = 0 Then
  186.        FrmChk!LblHis.Caption = Word
  187.        FrmChk!TxtNew = Word
  188.        If FrmChk!CkSuggest = 1 Then
  189.           hListBox = FrmChk!LstSuggest.hWnd
  190.           i = ReadDic(LexPath + "English.Lex", Mid(Word, 1, 3), hListBox)
  191.           If (i) Then
  192.              FrmChk!TxtNew = FrmChk!LstSuggest.List(0)
  193.           End If
  194.        End If
  195.        TestWord = 0
  196.     Else
  197.        TestWord = -1
  198.     End If
  199. End Function
  200.  
  201.